home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / lisp / stk-3.003 / stk-3 / stk / 3.1 / STk / describe.stk < prev    next >
Encoding:
Text File  |  1996-07-29  |  3.1 KB  |  95 lines
  1. ;;;;
  2. ;;;; The DESCRIBE method (partly stolen fom Elk lib)
  3. ;;;;
  4. ;;;; Copyright ⌐ 1993-1996 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
  5. ;;;; 
  6. ;;;; Permission to use, copy, and/or distribute this software and its
  7. ;;;; documentation for any purpose and without fee is hereby granted, provided
  8. ;;;; that both the above copyright notice and this permission notice appear in
  9. ;;;; all copies and derived works.  Fees for distribution or use of this
  10. ;;;; software or derived works may only be charged with express written
  11. ;;;; permission of the copyright holder.  
  12. ;;;; This software is provided ``as is'' without express or implied warranty.
  13. ;;;;
  14. ;;;;           Author: Erick Gallesio [eg@unice.fr]
  15. ;;;;    Creation date: 21-Mar-1993 14:33
  16. ;;;; Last file update: 27-Sep-1994 14:07
  17. ;;;;
  18.  
  19. (require "stklos")
  20. ;;;
  21. ;;; describe for simple objects
  22. ;;;
  23. (define-method describe ((x <top>))
  24.   (format #t "~s is " x)
  25.   (cond
  26.      ((integer? x)      (format #t "an integer"))
  27.      ((real?    x)      (format #t "a real"))
  28.      ((null?    x)      (format #t "an empty list"))
  29.      ((boolean?    x)      (format #t "a boolean value (~s)" (if x 'true 'false)))
  30.      ((char?    x)      (format #t "a character, ascii value is ~s" 
  31.                 (char->integer x)))
  32.      ((symbol?    x)      (format #t "a symbol"))
  33.      ((pair?    x)    (format #t "a list"))
  34.      ((string?    x)    (if (eqv? x "")
  35.                 (format #t "an empty string")
  36.                 (format #t "a string of length ~s" (string-length x))))
  37.      ((vector?  x)       (if (eqv? x '#())
  38.                 (format #t "an empty vector")
  39.                 (format #t "a vector of length ~s" (vector-length x))))
  40.      ((procedure? x)    (format #t "a procedure"))
  41.      ((environment? x)    (format #t "an environment"))
  42.      ((eof-object? x)    (format #t "the end-of-file object.~%"))
  43.      (else             (format #t "an unknown object (~s)" x)))
  44.   (format #t ".~%"))
  45.  
  46.  
  47. ;;;
  48. ;;; describe for STklos instances
  49. ;;;
  50. (define-method describe ((x <object>))
  51.   (format #t "~S is an instance of class ~A~%" x (class-name (class-of x)))
  52.  
  53.   ;; print all the instance slots
  54.   (format #t "Slots are: ~%")
  55.   (for-each (lambda (slot)
  56.           (let ((name (if (pair? slot) (car slot) slot)))
  57.         (format #t "     ~S = ~A~%" name 
  58.                         (if (slot-bound? x name) 
  59.                         (format #f "~S" (slot-ref x name))
  60.                         "#[unbound]"))))
  61.        (class-slots (class-of x)))
  62.   #f)
  63.  
  64. ;;;
  65. ;;; Describe for classes
  66. ;;;
  67. (define-method describe ((x <class>))
  68.   (format #t "~S is a class. It's an instance of ~A~%" 
  69.       (class-name x) (class-name (class-of x)))
  70.  
  71.   (format #t "Superclasses are:~%")
  72.   (for-each (lambda (class) (format #t "    ~A~%" (class-name class)))
  73.        (class-direct-supers x))
  74.  
  75.   (format #t "Directs slots are:~%") 
  76.   (for-each (lambda (s) 
  77.      (let ((slot (if (pair? s) (car s) s)))
  78.        (format #t "    ~A~%" slot)))
  79.        (class-direct-slots x))
  80.   
  81.   (format #t "Class Precedence List is:~%")
  82.   (for-each (lambda (s) (format #t "    ~A~%" (class-name s))) 
  83.         (class-precedence-list x))
  84.  
  85.   (format #t "~%Field Initializers ~%    ")
  86.   (write (slot-ref x 'initializers)) (newline)
  87.  
  88.   (format #t "~%Getters and Setters~%    ")
  89.   (write (slot-ref x 'getters-n-setters)) (newline)
  90.   #f
  91. )
  92.  
  93. (provide "describe")
  94.  
  95.